Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/checko1a/checkino.frm

Visual Basic Form | 1999-09-03 | 29.6 KB | 745 lines

VERSION 5.00
Begin VB.Form frmCheckInOut
   Caption         =   "Source Code Check In/Out"
   ClientHeight    =   1995
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   1995
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdResolve
      Height          =   450
      Left            =   3000
      Picture         =   "CheckInOut.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   10
      TabStop         =   0   'False
      ToolTipText     =   "Compare files to resolve conflicts"
      Top             =   850
      Width           =   450
   End
   Begin VB.Timer Timer
      Interval        =   60000
      Left            =   480
      Top             =   360
   End
   Begin VB.CommandButton cmdOptions
      Height          =   450
      Left            =   3502
      Picture         =   "CheckInOut.frx":0442
      Style           =   1  'Graphical
      TabIndex        =   9
      TabStop         =   0   'False
      ToolTipText     =   "Change application options"
      Top             =   850
      Width           =   450
   End
   Begin VB.CommandButton cmdNetDir
      Caption         =   "Net Directory:"
      Height          =   255
      Left            =   50
      TabIndex        =   8
      TabStop         =   0   'False
      ToolTipText     =   "Browse for network directory"
      Top             =   510
      Width           =   1335
   End
   Begin VB.CommandButton cmdLocalDir
      Caption         =   "Local Directory:"
      Height          =   255
      Left            =   50
      TabIndex        =   7
      TabStop         =   0   'False
      ToolTipText     =   "Browse for local directory"
      Top             =   80
      Width           =   1335
   End
   Begin VB.CommandButton cmdMessage
      Height          =   450
      Left            =   4000
      Picture         =   "CheckInOut.frx":0884
      Style           =   1  'Graphical
      TabIndex        =   6
      TabStop         =   0   'False
      ToolTipText     =   "Send a message"
      Top             =   850
      Width           =   575
   End
   Begin VB.CommandButton cmdHelp
      Caption         =   "Help"
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   1380
      Width           =   1215
   End
   Begin VB.CheckBox chkAutoCheck
      Caption         =   "Automatically check for file changes"
      Height          =   315
      Left            =   120
      TabIndex        =   2
      ToolTipText     =   "Pop up reminder message if files need updated."
      Top             =   960
      Value           =   1  'Checked
      Width           =   3195
   End
   Begin VB.CommandButton cmdCheckFiles
      Caption         =   "Check Files"
      Height          =   495
      Left            =   1440
      TabIndex        =   3
      Top             =   1380
      Width           =   1515
   End
   Begin VB.TextBox txtNetDir
      Height          =   315
      Left            =   1428
      TabIndex        =   1
      ToolTipText     =   "Directory with shared/network souce code files"
      Top             =   480
      Width           =   3135
   End
   Begin VB.TextBox txtLocalDir
      Height          =   315
      Left            =   1440
      TabIndex        =   0
      ToolTipText     =   "Directory with local source code files"
      Top             =   48
      Width           =   3135
   End
   Begin VB.CommandButton cmdUpdateFiles
      Caption         =   "Update Files"
      Height          =   495
      Left            =   3060
      TabIndex        =   4
      Top             =   1380
      Width           =   1515
   End
Attribute VB_Name = "frmCheckInOut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'API's for selecting a windows directory
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Type BROWSEINFO
   hOwner           As Long
   pidlRoot         As Long
   pszDisplayName   As String
   lpszTitle        As String
   ulFlags          As Long
   lpfn             As Long
   lParam           As Long
   iImage           As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = &H1
'API to get Window's logon user name
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'API to set order/positon of window
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
'variables suffix meanings:
'$ = string
'% = integer
Public User$
Public Minutes%
Public ChkLstFileDir$
Public Extension$
Public blnIgnoreExt As Boolean
Dim CheckTime As Date
Dim LocalMsg$
Dim NetMsg$
Public ConflictMsg$
Dim OutFileNames() As String
Dim OutFileDates() As Date
Dim OutFileSizes() As Long
Dim NetFileNames() As String
Dim NetFileDates() As Date
Dim NetFileSizes() As Long
Dim LocalFileNames() As String
Dim LocalFileDates() As Date
Dim LocalFileSizes() As Long
Dim NewLocalFiles() As String
Dim NewNetFiles() As String
Dim ConflictFileNames() As String
Private Sub chkAutoCheck_Click()
    If chkAutoCheck.Value = 1 Then
        Timer.Enabled = True
    Else
        Timer.Enabled = False
    End If
End Sub
Private Sub cmdCheckFiles_Click()
    If BuildNetArray Then 'quit if error
        If BuildLocalArray Then 'quit if error
            If Not CheckFiles Then
                MsgBox "Files on local and network are in-sync."
            End If
        End If
    End If
    CheckTime = Now
End Sub
Private Sub cmdResolve_Click()
    frmConflicts.Left = Me.Left
    frmConflicts.Top = Me.Top
    frmConflicts.Show
    Me.Hide
End Sub
Private Sub cmdUpdateFiles_Click()
    MousePointer = vbHourglass
    On Error GoTo NetDirError
    If Dir$(GetUserListFileDir) = "" And txtNetDir <> "" Then
        On Error GoTo 0
        BuildCheckOutList  'rebuild new list
    End If
    On Error GoTo 0
    If UBound(OutFileNames) = 0 Then
        Call BuildOutArray 'load check out files list
    End If
    If BuildNetArray Then 'quit if error
        If BuildLocalArray Then 'quit if error
            If SyncNetAndLocalFiles Then 'quit if error
                Call ReBuildCheckOutList
            End If
        End If
    End If
    MousePointer = vbDefault
    Exit Sub
NetDirError:
    MousePointer = vbDefault
    MsgBox "Invalid network directory: " & txtNetDir
End Sub
Private Sub BuildCheckOutList() 'returns true if no error
    Dim f%, i%, j%
    If BuildNetArray Then 'quit if error
        If BuildLocalArray Then 'quit if error
            f% = FreeFile
            Open GetUserListFileDir For Output As f%
            For i% = 1 To UBound(LocalFileNames)
                For j% = 1 To UBound(NetFileNames)
                    If LocalFileNames(i%) = NetFileNames(j%) Then
                        If LocalFileDates(i%) = NetFileDates(j%) And LocalFileSizes(i%) = NetFileSizes(j%) Then 'files are different
                            Print #f%, LocalFileNames(i%) & vbTab & Format$(LocalFileDates(i%), "mm/dd/yyyy hh:nn:ss") & vbTab & LocalFileSizes(i%)
                        End If
                        Exit For
                    End If
                Next j%
            Next i%
            Close f%
        End If
    End If
End Sub
Private Sub ReBuildCheckOutList()
    Dim f%, k%
    f% = FreeFile
    Open GetUserListFileDir For Output As f%
    For k% = 1 To UBound(OutFileNames)
        Print #f%, OutFileNames(k%) & vbTab & Format$(OutFileDates(k%), "mm/dd/yyyy hh:nn:ss") & vbTab & OutFileSizes(k%)
    Next k%
    Close f%
End Sub
Private Function BuildOutArray() As Boolean 'returns true if no error
    Dim f%, InLine$
    'reads checkout list file to arrays
    BuildOutArray = False
    If txtNetDir = "" Then Exit Function
    If Dir$(GetUserListFileDir) = "" Then
        MsgBox "Error: could not find file" & GetUserListFileDir & "!  You must check out code first."
        Exit Function
    End If
    f% = FreeFile
    Open GetUserListFileDir For Input As f%
    While Not EOF(f%)
        Line Input #f%, InLine$
        If Trim$(InLine$) <> "" Then
            ReDim Preserve OutFileNames(UBound(OutFileNames) + 1) As String
            ReDim Preserve OutFileDates(UBound(OutFileDates) + 1) As Date
            ReDim Preserve OutFileSizes(UBound(OutFileSizes) + 1) As Long
            OutFileNames(UBound(OutFileNames)) = Left$(InLine$, InStr(InLine$, vbTab) - 1)
            InLine$ = Mid$(InLine$, InStr(InLine$, vbTab) + 1)
            OutFileDates(UBound(OutFileDates)) = Left$(InLine$, InStr(InLine$, vbTab) - 1)
            InLine$ = Mid$(InLine$, InStr(InLine$, vbTab) + 1)
            OutFileSizes(UBound(OutFileSizes)) = InLine$
            BuildOutArray = True 'true if found something
        End If
    Wend
    Close f%
End Function
Private Function BuildNetArray() As Boolean 'returns true if no error
    Dim FileName$
    ReDim NetFileNames(0) As String
    ReDim NetFileDates(0) As Date
    ReDim NetFileSizes(0) As Long
    If txtNetDir = "" Then
        BuildNetArray = False
        Exit Function
    End If
    BuildNetArray = True
    If Right(txtNetDir, 1) <> "\" Then
        txtNetDir = txtNetDir & "\"
    End If
    On Error GoTo NetDirError
    FileName$ = Dir$(txtNetDir & "*.*")
    On Error GoTo 0
    If FileName$ = "" Then
        BuildNetArray = False
        MsgBox "Error: no files found in " & txtNetDir
        Exit Function
    End If
    While FileName$ <> ""
        ReDim Preserve NetFileNames(UBound(NetFileNames) + 1) As String
        ReDim Preserve NetFileDates(UBound(NetFileDates) + 1) As Date
        ReDim Preserve NetFileSizes(UBound(NetFileSizes) + 1) As Long
        NetFileNames(UBound(NetFileNames)) = FileName$
        NetFileDates(UBound(NetFileDates)) = FileDateTime(txtNetDir & FileName$)
        NetFileSizes(UBound(NetFileSizes)) = FileLen(txtNetDir & FileName$)
        FileName$ = Dir$
    Wend
    Exit Function
NetDirError:
    MsgBox "Invalid network directory: " & txtNetDir
    BuildNetArray = False
End Function
Private Function BuildLocalArray() As Boolean 'returns true if no error
    Dim FileName$
    ReDim LocalFileNames(0) As String
    ReDim LocalFileDates(0) As Date
    ReDim LocalFileSizes(0) As Long
    If txtLocalDir = "" Then
        BuildLocalArray = False
        Exit Function
    End If
    BuildLocalArray = True
    If Right(txtLocalDir, 1) <> "\" Then
        txtLocalDir = txtLocalDir & "\"
    End If
    FileName$ = Dir$(txtLocalDir & "*.*")
    If FileName$ = "" Then
        If MsgBox("Error: no files found in '" & txtLocalDir & "'. Continue anyhow?", vbYesNo + vbDefaultButton2 + vbExclamation) = vbNo Then
            BuildLocalArray = False
            Exit Function
        End If
    End If
    While FileName$ <> ""
        ReDim Preserve LocalFileNames(UBound(LocalFileNames) + 1) As String
        ReDim Preserve LocalFileDates(UBound(LocalFileDates) + 1) As Date
        ReDim Preserve LocalFileSizes(UBound(LocalFileSizes) + 1) As Long
        LocalFileNames(UBound(LocalFileNames)) = FileName$
        LocalFileDates(UBound(LocalFileDates)) = FileDateTime(txtLocalDir & FileName$)
        LocalFileSizes(UBound(LocalFileSizes)) = FileLen(txtLocalDir & FileName$)
        FileName$ = Dir$
    Wend
End Function
Private Function SyncNetAndLocalFiles() As Boolean 'returns true if copied ok
    Dim i%, j%, k%
    SyncNetAndLocalFiles = False
    Call SetVariables
    If NetMsg$ <> "" Then
        NetMsg$ = "The following new network files will be copied local:" & vbCrLf & NetMsg$
    End If
    If LocalMsg$ <> "" Then
        LocalMsg$ = "The following local files will be copied to the network:" & vbCrLf & LocalMsg$
    End If
    If LocalMsg$ = "" And NetMsg$ = "" And ConflictMsg$ = "" Then
        MsgBox "No files need to be copied."
        SyncNetAndLocalFiles = True
    ElseIf LocalMsg$ = "" And NetMsg$ = "" And ConflictMsg$ <> "" Then
        MsgBox ConflictMsg$ & "No files could be copied."
    Else
        If ConflictMsg$ <> "" Then
            MsgBox ConflictMsg$ & "Other files can still be copied."
        End If
        If NetMsg$ <> "" Then
            If MsgBox(NetMsg$, vbOKCancel, "Copy files to local drive?") = vbOK Then
                MsgBox "Remember to close the project from the source code editor first."
                For i% = 1 To UBound(NewNetFiles)
                    On Error Resume Next
                    FileCopy txtNetDir & NewNetFiles(i%), txtLocalDir & NewNetFiles(i%)
                    If Err <> 0 Then
                        MsgBox "Error: Could not copy/replace file " & NewNetFiles(i%)
                    Else
                        For j% = 1 To UBound(NetFileNames)
                            If NewNetFiles(i%) = NetFileNames(j%) Then
                                For k% = 1 To UBound(OutFileNames)
                                    If NetFileNames(j%) = OutFileNames(k%) Then
                                        OutFileDates(k%) = NetFileDates(j%)
                                        OutFileSizes(k%) = NetFileSizes(j%)
                                        k% = k% + 1
                                        Exit For
                                    End If
                                Next k%
                                If NetFileNames(j%) <> OutFileNames(k% - 1) Then
                                    ReDim Preserve OutFileNames(UBound(OutFileNames) + 1) As String
                                    ReDim Preserve OutFileDates(UBound(OutFileDates) + 1) As Date
                                    ReDim Preserve OutFileSizes(UBound(OutFileSizes) + 1) As Long
                                    OutFileNames(UBound(OutFileNames)) = NetFileNames(j%)
                                    OutFileDates(UBound(OutFileDates)) = NetFileDates(j%)
                                    OutFileSizes(UBound(OutFileSizes)) = NetFileSizes(j%)
                                End If
                                Exit For
                            End If
                        Next j%
                    End If
                    On Error GoTo 0
                Next i%
            End If
        End If
        If LocalMsg$ <> "" Then
            If MsgBox(LocalMsg$, vbOKCancel, "Copy files to network?") = vbOK Then
                For i% = 1 To UBound(NewLocalFiles)
                    On Error Resume Next
                    FileCopy txtLocalDir & NewLocalFiles(i%), txtNetDir & NewLocalFiles(i%)
                    If Err <> 0 Then
                        MsgBox "Error: Could not copy/replace file " & NewLocalFiles(i%)
                    Else
                        For j% = 1 To UBound(LocalFileNames)
                            If NewLocalFiles(i%) = LocalFileNames(j%) Then
                                For k% = 1 To UBound(OutFileNames)
                                    If LocalFileNames(j%) = OutFileNames(k%) Then
                                        OutFileDates(k%) = LocalFileDates(j%)
                                        OutFileSizes(k%) = LocalFileSizes(j%)
                                        k% = k% + 1
                                        Exit For
                                    End If
                                Next k%
                                If LocalFileNames(j%) <> OutFileNames(k% - 1) Then
                                    ReDim Preserve OutFileNames(UBound(OutFileNames) + 1) As String
                                    ReDim Preserve OutFileDates(UBound(OutFileDates) + 1) As Date
                                    ReDim Preserve OutFileSizes(UBound(OutFileSizes) + 1) As Long
                                    OutFileNames(UBound(OutFileNames)) = LocalFileNames(j%)
                                    OutFileDates(UBound(OutFileDates)) = LocalFileDates(j%)
                                    OutFileSizes(UBound(OutFileSizes)) = LocalFileSizes(j%)
                                End If
                                Exit For
                            End If
                        Next j%
                    End If
                    On Error GoTo 0
                Next i%
            End If
        End If
        SyncNetAndLocalFiles = True
    End If
End Function
Private Function CheckFiles() As Boolean 'returns true if copied ok
    CheckFiles = False
    Call SetVariables
    If NetMsg$ <> "" Then
        NetMsg$ = "New files on the network:" & vbCrLf & NetMsg$ & vbCrLf
    End If
    If LocalMsg$ <> "" Then
        LocalMsg$ = "New files local files:" & vbCrLf & LocalMsg$
    End If
    If NetMsg$ <> "" Or LocalMsg$ <> "" Or ConflictMsg$ <> "" Then
        CheckFiles = True
        Beep
        Call OnTopYes(Me.hwnd)
        MsgBox ConflictMsg$ & NetMsg$ & LocalMsg$
        Call OnTopNo(Me.hwnd)
    End If
End Function
Private Sub FindNewLocalFiles()
    Dim i%, j%, k%
    ReDim NewLocalFiles(0) As String
    ReDim ConflictFileNames(0) As String
    Dim foundConflict As Boolean
    Dim found As Boolean
    For i% = 1 To UBound(LocalFileNames)
        found = False
        For j% = 1 To UBound(NetFileNames)
            If LocalFileNames(i%) = NetFileNames(j%) Then
                If LocalFileDates(i%) <> NetFileDates(j%) Or LocalFileSizes(i%) <> NetFileSizes(j%) Then 'files are different
                    If LocalFileDates(i%) > NetFileDates(j%) Then 'local file is newer
                        foundConflict = True
                        For k% = 1 To UBound(OutFileNames)
                            If NetFileNames(j%) = OutFileNames(k%) Then
                                foundConflict = False
                                If NetFileDates(j%) = OutFileDates(k%) And NetFileSizes(j%) = OutFileSizes(k%) Then
                                    ReDim Preserve NewLocalFiles(UBound(NewLocalFiles) + 1) As String
                                    NewLocalFiles(UBound(NewLocalFiles)) = LocalFileNames(i%)
                                Else
                                    ReDim Preserve ConflictFileNames(UBound(ConflictFileNames) + 1) As String
                                    ConflictFileNames(UBound(ConflictFileNames)) = LocalFileNames(i%)
                                End If
                                Exit For
                            End If
                        Next k%
                        If foundConflict Then 'catch confict if never checked out
                            ReDim Preserve ConflictFileNames(UBound(ConflictFileNames) + 1) As String
                            ConflictFileNames(UBound(ConflictFileNames)) = LocalFileNames(i%)
                        End If
                    End If
                End If
                found = True
                Exit For
            End If
        Next j%
        If found = False Then 'new, doesn't exist on net
            ReDim Preserve NewLocalFiles(UBound(NewLocalFiles) + 1) As String
            NewLocalFiles(UBound(NewLocalFiles)) = LocalFileNames(i%)
        End If
    Next i%
End Sub
Private Sub FindNewNetFiles()
    Dim i%, j%, k%
    ReDim NewNetFiles(0) As String
    ReDim ConflictFileNames(0) As String
    Dim found As Boolean
    Dim foundConflict As Boolean
    For i% = 1 To UBound(NetFileNames)
        found = False
        For j% = 1 To UBound(LocalFileNames)
            If NetFileNames(i%) = LocalFileNames(j%) Then
                If NetFileDates(i%) <> LocalFileDates(j%) Or NetFileSizes(i%) <> LocalFileSizes(j%) Then 'files are different
                    If NetFileDates(i%) > LocalFileDates(j%) Then
                        foundConflict = True
                        For k% = 1 To UBound(OutFileNames)
                            If LocalFileNames(j%) = OutFileNames(k%) Then
                                foundConflict = False
                                If LocalFileDates(j%) = OutFileDates(k%) And LocalFileSizes(j%) = OutFileSizes(k%) Then
                                    ReDim Preserve NewNetFiles(UBound(NewNetFiles) + 1) As String
                                    NewNetFiles(UBound(NewNetFiles)) = NetFileNames(i%)
                                Else
                                    ReDim Preserve ConflictFileNames(UBound(ConflictFileNames) + 1) As String
                                    ConflictFileNames(UBound(ConflictFileNames)) = NetFileNames(i%)
                                End If
                                Exit For
                            End If
                        Next k%
                        If foundConflict Then 'catch confict if never checked out
                            ReDim Preserve ConflictFileNames(UBound(ConflictFileNames) + 1) As String
                            ConflictFileNames(UBound(ConflictFileNames)) = NetFileNames(i%)
                        End If
                    End If
                End If
                found = True
                Exit For
            End If
        Next j%
        If found = False Then 'new, doesn't exist on net
            ReDim Preserve NewNetFiles(UBound(NewNetFiles) + 1) As String
            NewNetFiles(UBound(NewNetFiles)) = NetFileNames(i%)
        End If
    Next i%
End Sub
Private Sub SetVariables()
    Dim OneExtension$, i%, start%
    LocalMsg$ = ""
    NetMsg$ = ""
    ConflictMsg$ = ""
    Call FindNewLocalFiles
    For i% = 1 To UBound(NewLocalFiles)
        LocalMsg$ = LocalMsg$ & NewLocalFiles(i%) & vbCrLf
    Next i%
    For i% = 1 To UBound(ConflictFileNames)
        If blnIgnoreExt = False Or Extension$ = "" Then
            ConflictMsg$ = ConflictMsg$ & ConflictFileNames(i%) & vbCrLf
        Else
            start% = 1
            Do While InStr(start%, Extension$ & ",", ",") > 0 And start% < Len(Extension$)
                OneExtension$ = Mid$(Extension$, start%, InStr(start%, Extension$ & ",", ",") - 1)
                start% = InStr(start%, Extension$ & ",", ",") + 1
                If OneExtension$ = Right$(ConflictFileNames(i%), Len(OneExtension$)) Then
                    start% = -1
                    Exit Do
                End If
            Loop
            If start% <> -1 Then
                ConflictMsg$ = ConflictMsg$ & ConflictFileNames(i%) & vbCrLf
            End If
        End If
    Next i%
    Call FindNewNetFiles
    For i% = 1 To UBound(NewNetFiles)
        NetMsg$ = NetMsg$ & NewNetFiles(i%) & vbCrLf
    Next i%
    For i% = 1 To UBound(ConflictFileNames)
        If blnIgnoreExt = False Or Extension$ = "" Then
            ConflictMsg$ = ConflictMsg$ & ConflictFileNames(i%) & vbCrLf
        Else
            start% = 1
            Do While InStr(start%, Extension$ & ",", ",") > 0 And start% < Len(Extension$)
                OneExtension$ = Mid$(Extension$, start%, InStr(start%, Extension$ & ",", ",") - 1)
                start% = InStr(start%, Extension$ & ",", ",") + 1
                If OneExtension$ = Right$(ConflictFileNames(i%), Len(OneExtension$)) Then
                    start% = -1
                    Exit Do
                End If
            Loop
            If start% <> -1 Then
                ConflictMsg$ = ConflictMsg$ & ConflictFileNames(i%) & vbCrLf
            End If
        End If
    Next i%
    If ConflictMsg$ <> "" Then
        ConflictMsg$ = "Conflicts: Files changed on network!:" & vbCrLf & ConflictMsg$ & vbCrLf
    End If
End Sub
Private Sub cmdHelp_Click()
    frmHelp.Left = Me.Left
    frmHelp.Top = Me.Top
    frmHelp.Show
    Me.Hide
End Sub
Private Sub cmdLocalDir_Click()
    Dim tmpDir$
    tmpDir$ = GetDirectory
    If tmpDir$ <> "" Then
        txtLocalDir = tmpDir$ & "\"
    End If
End Sub
Private Sub cmdMessage_Click()
    frmNetSend.Left = Me.Left
    frmNetSend.Top = Me.Top
    frmNetSend.Show
    Me.Hide
End Sub
Private Sub cmdNetDir_Click()
    Dim tmpDir$
    tmpDir$ = GetDirectory
    If tmpDir$ <> "" Then
        txtNetDir = tmpDir$ & "\"
    End If
End Sub
Private Sub cmdOptions_Click()
    frmOptions.Left = Me.Left
    frmOptions.Top = Me.Top
    frmOptions.Show
    Me.Hide
End Sub
Private Sub Form_Load()
    If App.PrevInstance Then End
    Me.Left = GetSetting(App.EXEName, "Window", "X", 0)
    Me.Top = GetSetting(App.EXEName, "Window", "Y", 0)
    txtNetDir = GetSetting(App.EXEName, "Paths", "Network", txtNetDir)
    txtLocalDir = GetSetting(App.EXEName, "Paths", "Local", txtLocalDir)
    chkAutoCheck = GetSetting(App.EXEName, "Settings", "AutoCheck", chkAutoCheck)
    Minutes% = GetSetting(App.EXEName, "Settings", "CheckMinutes", "15")
    ChkLstFileDir$ = GetSetting(App.EXEName, "Settings", "CheckListFileDir", "<NetDir>\..")
    blnIgnoreExt = GetSetting(App.EXEName, "Settings", "IgnoreExt", True)
    Extension$ = GetSetting(App.EXEName, "Settings", "Extension", ".vbw")
    If GetSetting(App.EXEName, "Paths", "Local") = "" Then
        frmHelp.cmbTopic = "Initial Configuration:"
        Call cmdHelp_Click
    End If
    If Right(txtNetDir, 1) <> "\" And txtNetDir <> "" Then
        txtNetDir = txtNetDir & "\"
    End If
    '----------------------------------
    ' find latest source code directory
    '----------------------------------
    'HighVer$ = "0.0"
    'DirName$ = Dir$(txtNetDir & "Version*", vbDirectory)
    'If DirName$ = "" Then
    '    Exit Sub
    'End If
    'While DirName$ <> ""
    '    If Val(Mid$(HighVer$, InStr(HighVer$, ".") - 1)) < Val(Mid$(DirName$, InStr(DirName$, ".") - 1)) Then
    '        HighVer$ = DirName$
    '    End If
    '    DirName$ = Dir$
    'Wend
    'If HighVer$ <> "0.0" Then
    '    txtNetDir = txtNetDir & HighVer$ & "\"
    'End If
    '----------------------------------
    Dim BuffSize As Long 'get Windows user name
    BuffSize = 199
    User$ = String$(200, 0)
    If GetUserName(User$, BuffSize) = 0 Then
        MsgBox "Error getting username."
    Else
        User$ = Left$(User$, InStr(User$, Chr$(0)) - 1)
    End If
    ReDim OutFileNames(0) As String
    ReDim OutFileDates(0) As Date
    ReDim OutFileSizes(0) As Long
    On Error GoTo NetDirError
    If Dir$(GetUserListFileDir) = "" And txtNetDir <> "" Then
        On Error GoTo 0
        BuildCheckOutList  'rebuild new list
    End If
    On Error GoTo 0
    If txtNetDir <> "" Then
        Call BuildOutArray 'load check out files list
    End If
    CheckTime = DateAdd("n", -1 * (Minutes% + 1), Now)
    Call Timer_Timer
    Exit Sub
NetDirError:
    MsgBox "Invalid network directory: " & txtNetDir
    CheckTime = Now
    On Error GoTo 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
    SaveSetting App.EXEName, "Window", "X", Me.Left
    SaveSetting App.EXEName, "Window", "Y", Me.Top
    SaveSetting App.EXEName, "Paths", "Network", txtNetDir
    SaveSetting App.EXEName, "Paths", "Local", txtLocalDir
    SaveSetting App.EXEName, "Settings", "AutoCheck", chkAutoCheck
    SaveSetting App.EXEName, "Settings", "CheckMinutes", Minutes%
    SaveSetting App.EXEName, "Settings", "CheckListFileDir", ChkLstFileDir$
    SaveSetting App.EXEName, "Settings", "IgnoreExt", blnIgnoreExt
    SaveSetting App.EXEName, "Settings", "Extension", Extension$
End Sub
Private Sub Timer_Timer()
    Dim OtherUserIn As Date
    Dim OtherUserOut As Date
    If DateAdd("n", Minutes%, CheckTime) < Now Then
        'check for updated files
        CheckTime = Now
        If BuildNetArray Then 'quit if error
            If BuildLocalArray Then 'quit if error
                If Not CheckFiles Then
                    'no new files, ignore
                End If
            End If
        End If
    End If
    Exit Sub
End Sub
Private Sub OnTopYes(WinHandle As Long)
    Call SetWindowPos(WinHandle, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
End Sub
Private Sub OnTopNo(WinHandle As Long)
    Call SetWindowPos(WinHandle, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
End Sub
Public Function GetDirectory() As String
    Dim bi As BROWSEINFO
    Dim pidl As Long
    Dim path$, pos%
    bi.hOwner = Me.hwnd
    bi.pidlRoot = 0&
    bi.lpszTitle = "Select directory..."
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    pidl = SHBrowseForFolder(bi)
    path = Space$(256)
    If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
       pos = InStr(path, Chr$(0))
       GetDirectory = Left(path, pos - 1)
    End If
    Call CoTaskMemFree(pidl)
End Function
Public Function GetUserListFileDir(Optional strUser$ = "") As String
    If strUser$ = "" Then
        strUser$ = User$
    End If
    Select Case ChkLstFileDir$
    Case "<NetDir>\.."
        GetUserListFileDir = txtNetDir & "..\checkout_" & strUser$ & ".lst"
    Case "<AppDir>"
        GetUserListFileDir = App.path & "\checkout_" & strUser$ & ".lst"
    Case Else
        GetUserListFileDir = ChkLstFileDir$ & "checkout_" & strUser$ & ".lst"
    End Select
End Function